home *** CD-ROM | disk | FTP | other *** search
Text File | 1990-10-25 | 73.2 KB | 2,818 lines | [TEXT/MPS ] |
- {$P}
- {[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
- { UGridView.inc1.p }
- { Copyright © 1987-1990 by Apple Computer Inc. All rights reserved. }
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVInit}
-
- PROCEDURE InitUGridView;
-
- BEGIN
- IF qTemplateViews THEN
- BEGIN
- { So the linker doesn't dead strip these }
- IF gDeadStripSuppression THEN
- BEGIN
- IF Member(TObject(NIL), TGridView) THEN;
- IF Member(TObject(NIL), TTextGridView) THEN;
- IF Member(TObject(NIL), TTextListView) THEN;
- END;
-
- RegisterStdType('TGridView', kStdGridView);
- RegisterStdType('TTextGridView', kStdTextGridView);
- RegisterStdType('TTextListView', kStdTextListView);
- END;
-
- pPixelsToHighlight := MakeNewRgn;
- pPreviousSelection := MakeNewRgn;
- pDifference := MakeNewRgn;
- pVisibleCells := MakeNewRgn;
- pInvalidateRgn := MakeNewRgn;
- gUGridViewInitialized := TRUE;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVOpen}
-
- PROCEDURE TRunArray.IRunArray;
-
- BEGIN
- IObject;
-
- fNoOfItems := 0;
- fNoOfChunks := 0;
- fTotal := 0;
- fLastItem := 0;
- fLastChunk := 0;
- fLastTotal := 0;
- fLastIndex := 1;
- fChunks := ChunkArrayHandle(NewPermHandle(0));
- FailNIL(fChunks);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVClose}
-
- PROCEDURE TRunArray.Free; OVERRIDE;
-
- BEGIN
- Handle(fChunks) := DisposeIfHandle(fChunks); { Blow chunks }
-
- INHERITED Free;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TRunArray.DeleteItems(firstItem, noOfItems: INTEGER);
-
- VAR
- offset: LONGINT;
- result: LONGINT;
- i: INTEGER;
- num: INTEGER;
- theTotal: LONGINT;
- Index: INTEGER;
-
- BEGIN
- IF NOT FindChunk(firstItem, num, Index, theTotal) THEN
- BEGIN
- {$IFC qDebug}
- ProgramBreak(ConcatNumber('Unable to find chunk for item ', firstItem));
- {$ENDC}
- EXIT(DeleteItems);
- END;
-
- FOR i := 1 TO noOfItems DO
- BEGIN
- fTotal := fTotal - fChunks^^[num].value;
-
- fChunks^^[num].count := fChunks^^[num].count - 1;
-
- IF (fChunks^^[num].count < Index) THEN
- BEGIN
- IF (fChunks^^[num].count = 0) THEN
- BEGIN
- { need to delete that chunk }
- offset := IntMultiply(num, SIZEOF(RunArrayChunk));
- result := Munger(Handle(fChunks), offset, NIL, SIZEOF(RunArrayChunk), @result, 0);
- FailMemError;
- fNoOfChunks := fNoOfChunks - 1;
-
- { Thanks JDR 10/28/89 }
- { see if we can consolidate chunks }
- IF (num > 0) & (num < fNoOfChunks) & (fChunks^^[num - 1].value =
- fChunks^^[num].value) THEN
- BEGIN
- Index := fChunks^^[num - 1].count + 1;
- fChunks^^[num - 1].count := fChunks^^[num - 1].count + fChunks^^[num].count;
- { need to delete that chunk }
- result := Munger(Handle(fChunks), offset, NIL, SIZEOF(RunArrayChunk), @result,
- 0);
- FailMemError;
- num := num - 1;
- fNoOfChunks := fNoOfChunks - 1;
- END;
- END
- ELSE
- num := num + 1;
- Index := 1;
- END;
- END;
-
- fNoOfItems := fNoOfItems - noOfItems;
-
- { reset the cache }
- fLastItem := 0;
- fLastChunk := 0;
- fLastTotal := 0;
- fLastIndex := 1;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVFields}
-
- PROCEDURE TRunArray.Fields(PROCEDURE DoToField(fieldName: Str255;
- fieldAddr: Ptr;
- fieldType: INTEGER)); OVERRIDE;
-
- VAR
- aString, numString: Str255;
- i: INTEGER;
-
- BEGIN
- DoToField('TRunArray', NIL, bClass);
- DoToField('fNoOfItems', @fNoOfItems, bInteger);
- DoToField('fNoOfChunks', @fNoOfChunks, bInteger);
- DoToField('fTotal', @fTotal, bLongInt);
- DoToField('fLastItem', @fLastItem, bInteger);
- DoToField('fLastChunk', @fLastChunk, bInteger);
- DoToField('fLastTotal', @fLastTotal, bLongInt);
- DoToField('fLastIndex', @fLastIndex, bInteger);
-
- { !!! When these come from the dynamic area remember to put the field in the DynamicField method }
- FOR i := 0 TO fNoOfChunks - 1 DO
- BEGIN
- NumToString(i, numString);
- aString := Concat('count[', numString, ']');
- DoToField(aString, @fChunks^^[i].count, bInteger);
- aString := Concat('value[', numString, ']');
- DoToField(aString, @fChunks^^[i].value, bInteger);
- END;
- INHERITED Fields(DoToField);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
- {$Push} {$OV-} {!!!SRF remove this line when the compiler
- gets smarter }
-
- FUNCTION TRunArray.FindChunk(item: INTEGER;
- VAR chunk, indexInChunk: INTEGER;
- VAR theTotal: LONGINT): BOOLEAN;
-
- VAR
- thisItem: INTEGER;
- count: INTEGER;
- delta: INTEGER;
-
- BEGIN
- IF (fNoOfChunks <= 0) | (item > fNoOfItems) | (item <= 0) THEN
- BEGIN
- chunk := 0;
- theTotal := 0;
- indexInChunk := 0;
- FindChunk := FALSE;
- item := 0;
- END
- ELSE IF (item = fLastItem) THEN
- BEGIN { check for the very easy case }
- chunk := fLastChunk;
- theTotal := fLastTotal;
- indexInChunk := fLastIndex;
- FindChunk := TRUE;
- END
- ELSE
- BEGIN
- delta := ABS(item - fLastItem);
-
- IF (delta >= item) | (item <= fChunks^^[0].count) THEN
- BEGIN { start from the first chunk }
- chunk := 0;
- theTotal := 0;
- thisItem := 0;
- END
- ELSE IF (delta > (fNoOfItems - item + 1)) THEN
- BEGIN { start from the end chunk }
- chunk := fNoOfChunks - 1;
- count := fChunks^^[chunk].count;
- theTotal := fTotal - IntMultiply(count, fChunks^^[chunk].value);
- thisItem := fNoOfItems - count;
- END
- ELSE
- BEGIN { start from the previous values }
- chunk := fLastChunk;
- theTotal := fLastTotal;
- thisItem := fLastItem - fLastIndex;
- END;
-
- IF item > thisItem THEN
- BEGIN
- WHILE ((thisItem + fChunks^^[chunk].count) < item) DO
- BEGIN
- count := fChunks^^[chunk].count;
- theTotal := theTotal + IntMultiply(count, fChunks^^[chunk].value);
- thisItem := thisItem + count;
- chunk := chunk + 1;
- END;
- END
- ELSE
- BEGIN
- REPEAT
- chunk := chunk - 1;
- count := fChunks^^[chunk].count;
- theTotal := theTotal - IntMultiply(count, fChunks^^[chunk].value);
- thisItem := thisItem - count;
- UNTIL (thisItem < item);
- END;
- indexInChunk := item - thisItem;
- FindChunk := TRUE;
- END;
- { cache the last values }
- fLastItem := item;
- fLastChunk := chunk;
- fLastTotal := theTotal;
- fLastIndex := indexInChunk;
- END;
- {$Pop}
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TRunArray.FindItem(theTotal: LONGINT): INTEGER;
-
- VAR
- i: INTEGER;
- runningCount: INTEGER;
-
- BEGIN
- FindItem := 0;
- IF (theTotal >= 0) & (theTotal <= fTotal) & (fNoOfChunks > 0) THEN
- IF fNoOfChunks = 1 THEN
- BEGIN
- IF fChunks^^[0].value > 0 THEN
- FindItem := Min(((theTotal - 1) DIV fChunks^^[0].value) + 1, fNoOfItems);
- END
- ELSE IF theTotal = 0 THEN
- FindItem := 1
- ELSE
- BEGIN
- theTotal := theTotal + 1;
- runningCount := 0;
- FOR i := 0 TO fNoOfChunks - 1 DO
- WITH fChunks^^[i] DO
- BEGIN
- theTotal := theTotal - IntMultiply(value, count);
- runningCount := runningCount + count;
- IF theTotal <= 0 THEN
- BEGIN
- FindItem := runningCount + (theTotal DIV value);
- EXIT(FindItem);
- END;
- END;
- FindItem := fNoOfItems;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TRunArray.GetValue(item: INTEGER): INTEGER;
-
- VAR
- num: INTEGER;
- theTotal: LONGINT;
- Index: INTEGER;
-
- BEGIN
- IF fNoOfChunks = 1 THEN
- GetValue := fChunks^^[0].value
- ELSE IF FindChunk(item, num, Index, theTotal) THEN
- GetValue := fChunks^^[num].value
- ELSE
- GetValue := 0;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TRunArray.InsertItems(firstItem, noOfItems, value: INTEGER);
-
- VAR
- num: INTEGER;
- theTotal: LONGINT;
- Index: INTEGER;
- oldSize: LONGINT;
- result: LONGINT;
- tempChunks: RECORD
- chunk1: RunArrayChunk;
- chunk2: RunArrayChunk;
- END;
-
- BEGIN
- { Check if we can just increment the last size count }
- IF (firstItem > fNoOfItems) & (fNoOfChunks > 0) & (fChunks^^[fNoOfChunks - 1].value =
- value) THEN
-
- fChunks^^[fNoOfChunks - 1].count := fChunks^^[fNoOfChunks - 1].count + noOfItems
-
- { check if we can increment any size count }
- ELSE IF FindChunk(firstItem, num, Index, theTotal) & (fChunks^^[num].value = value) THEN
-
- fChunks^^[num].count := fChunks^^[num].count + noOfItems
-
- { check if this would actually fit as the last item in the previous chunk }
- { Thanks Martin Frické, 10/31/89 }
- ELSE IF (num > 0) & (Index = 1) & (fChunks^^[num - 1].value = value) THEN
- fChunks^^[num - 1].count := fChunks^^[num - 1].count + noOfItems
-
- { We need to create a new chunk, possibly two }
- ELSE
- BEGIN
- oldSize := GetHandleSize(Handle(fChunks));
- tempChunks.chunk1.value := value;
- tempChunks.chunk1.count := noOfItems;
-
- IF (Index <= 1) | (firstItem > fNoOfItems) THEN
- BEGIN { need to add one chunk }
- IF (firstItem > fNoOfItems) THEN
- num := fNoOfChunks; { add a row on the end }
-
- result := Munger(Handle(fChunks), IntMultiply(num, SIZEOF(RunArrayChunk)), NIL, 0,
- @tempChunks, SIZEOF(RunArrayChunk));
- FailMemError;
- fNoOfChunks := fNoOfChunks + 1;
- END
- ELSE
- BEGIN
- { need to add two }
- tempChunks.chunk2.count := fChunks^^[num].count - Index + 1;
- tempChunks.chunk2.value := fChunks^^[num].value;
- fChunks^^[num].count := Index - 1;
- result := Munger(Handle(fChunks), IntMultiply(num + 1, SIZEOF(RunArrayChunk)), NIL, 0,
- @tempChunks, 2 * SIZEOF(RunArrayChunk));
- FailMemError;
- fNoOfChunks := fNoOfChunks + 2;
- END;
- IF GetHandleSize(Handle(fChunks)) <= oldSize THEN
- Failure(memFullErr, 0);
- END;
-
- { reset the cache }
- fLastItem := 0;
- fLastChunk := 0;
- fLastTotal := 0;
- fLastIndex := 1;
-
- fNoOfItems := fNoOfItems + noOfItems;
- fTotal := fTotal + IntMultiply(noOfItems, value);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TRunArray.SumValues(firstItem, noOfItems: INTEGER): LONGINT;
-
- VAR
- chunk: INTEGER;
- indexInChunk: INTEGER;
- total: LONGINT;
- precedingTotal: LONGINT;
-
- BEGIN
- SumValues := 0;
-
- IF fNoOfChunks = 1 THEN
- SumValues := IntMultiply(noOfItems, fChunks^^[0].value)
- ELSE IF firstItem = 1 THEN
- BEGIN
- IF FindChunk(noOfItems, chunk, indexInChunk, total) THEN
- SumValues := total + IntMultiply(indexInChunk, fChunks^^[chunk].value);
- END
- ELSE IF FindChunk(firstItem, chunk, indexInChunk, total) THEN
- BEGIN
- precedingTotal := total + IntMultiply(indexInChunk - 1, fChunks^^[chunk].value);
- IF FindChunk(firstItem + noOfItems - 1, chunk, indexInChunk, total) THEN
- SumValues := total + IntMultiply(indexInChunk, fChunks^^[chunk].value) - precedingTotal;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVOpen}
-
- PROCEDURE TGridView.IGridView(itsDocument: TDocument; { Its document }
- itsSuperView: TView; { Its parent view }
- itsLocation: VPoint; { Top, Left in parent's coords }
- itsSize: VPoint; { Ignored for SizeVariable}
- itsHSizeDet, itsVSizeDet: SizeDeterminer; { Size determiners }
- numOfRows: INTEGER; { Number of rows initially }
- numOfCols: INTEGER; { Number of columns initially }
- rowHeight: INTEGER; { Height of initial rows }
- colWidth: INTEGER; { Height of initial columns }
- adornRows: BOOLEAN; { Adornment for Rows? }
- adornCols: BOOLEAN; { Adornment for Columns? }
- rowInset: INTEGER; { horizontal space between cells }
- colInset: INTEGER; { vertical space between cells }
- singleSelection: BOOLEAN); { single cell selection? }
-
- VAR
- aRunArray: TRunArray;
- fi: FailInfo;
-
- PROCEDURE HandleFailure (error: OSErr; message: LONGINT);
-
- BEGIN
- Free;
- END;
-
- BEGIN
- fSelections := NIL;
- fHLRegion := NIL;
- fTempSelections := NIL;
- fColWidths := NIL;
- fRowHeights := NIL;
-
- {$IFC qDebug}
- IF NOT gUGridViewInitialized THEN
- BEGIN
- ProgramBreak('InitUGridView must be called before creating a grid view.');
- Failure(noErr, 0);
- END;
- {$ENDC}
-
- fNumOfRows := 0;
- fNumOfCols := 0;
-
- fAdornRows := adornRows;
- fAdornCols := adornCols;
-
- { Make sure the insets are evenly divided between top/bottom or left/right }
- IF ODD(rowInset) THEN
- fRowInset := rowInset + 1
- ELSE
- fRowInset := rowInset;
-
- IF ODD(colInset) THEN
- fColInset := colInset + 1
- ELSE
- fColInset := colInset;
-
- IView(itsDocument, itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet);
-
- CatchFailures(fi, HandleFailure);
-
- New(aRunArray);
- FailNIL(aRunArray);
- fColWidths := aRunArray;
- fColWidths.IRunArray;
-
- New(aRunArray);
- FailNIL(aRunArray);
- fRowHeights := aRunArray;
- fRowHeights.IRunArray;
-
- fSelections := MakeNewRgn; { region to hold current selections }
- fHLRegion := MakeNewRgn; { region to hold current highlighted cells }
- fTempSelections := MakeNewRgn; { used by SetSelectionRect }
-
- fSingleSelection := singleSelection;
-
- IF (numOfCols > 0) THEN
- InsColFirst(numOfCols, colWidth);
- IF (numOfRows > 0) THEN
- InsRowFirst(numOfRows, rowHeight);
-
- Success(fi);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVOpen}
-
- PROCEDURE TGridView.IRes(itsDocument: TDocument;
- itsSuperView: TView;
- VAR itsParams: Ptr); OVERRIDE;
-
- VAR
- aRunArray: TRunArray;
- fi: FailInfo;
-
- PROCEDURE HandleFailure (error: OSErr; message: LONGINT);
-
- BEGIN
- Free;
- END;
-
- BEGIN
- fSelections := NIL;
- fHLRegion := NIL;
- fTempSelections := NIL;
- fColWidths := NIL;
- fRowHeights := NIL;
-
- {$IFC qDebug}
- IF NOT gUGridViewInitialized THEN
- BEGIN
- ProgramBreak('InitUGridView must be called before creating a grid view.');
- Failure(noErr, 0);
- END;
- {$ENDC}
-
- INHERITED IRes(itsDocument, itsSuperView, itsParams);
-
- WITH GridViewTemplatePtr(itsParams)^ DO
- BEGIN
- fNumOfRows := 0;
- fNumOfCols := 0;
-
- fAdornRows := adornRows;
- fAdornCols := adornCols;
-
- { Make sure the insets are evenly divided between top/bottom or left/right }
- IF ODD(rowInset) THEN
- fRowInset := rowInset + 1
- ELSE
- fRowInset := rowInset;
-
- IF ODD(colInset) THEN
- fColInset := colInset + 1
- ELSE
- fColInset := colInset;
-
- fSingleSelection := singleSelection;
-
-
- CatchFailures(fi, HandleFailure);
-
- New(aRunArray);
- FailNIL(aRunArray);
- fColWidths := aRunArray;
- fColWidths.IRunArray;
-
- New(aRunArray);
- FailNIL(aRunArray);
- fRowHeights := aRunArray;
- fRowHeights.IRunArray;
-
- fSelections := MakeNewRgn; { region to hold current selections }
- fHLRegion := MakeNewRgn; { region to hold current highlighted cells }
- fTempSelections := MakeNewRgn; { used by SetSelectionRect }
-
- IF (numOfCols > 0) THEN
- InsColFirst(numOfCols, colWidth);
- IF (numOfRows > 0) THEN
- InsRowFirst(numOfRows, rowHeight);
-
- END;
-
- OffsetPtr(itsParams, SIZEOF(GridViewTemplate));
-
- Success(fi);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TGridView.WRes(theResource: ViewRsrcHndl;
- VAR itsParams: Ptr); OVERRIDE;
-
- VAR
- gvPtr: GridViewTemplatePtr;
-
- BEGIN
- INHERITED WRes(theResource, itsParams);
-
- gvPtr := GridViewTemplatePtr(ExpandPtr(theResource, itsParams, SIZEOF(GridViewTemplate)));
-
- WITH gvPtr^ DO
- BEGIN
- numOfRows := fNumOfRows;
- numOfCols := fNumOfCols;
- IF fNumOfRows > 0 THEN
- rowHeight := GetRowHeight(1)
- ELSE
- rowHeight := 0;
- IF fNumOfCols > 0 THEN
- colWidth := GetColWidth(1)
- ELSE
- colWidth := 0;
- rowInset := fRowInset;
- colInset := fColInset;
- adornRows := fAdornRows;
- adornCols := fAdornCols;
- singleSelection := fSingleSelection;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TGridView.WriteRes(theResource: ViewRsrcHndl;
- VAR itsParams: Ptr); OVERRIDE;
-
- BEGIN
- gWResSignature := 'grid'; gWResType := 'TGridView';
- WRes(theResource, itsParams);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVClose}
-
- PROCEDURE TGridView.Free; OVERRIDE;
-
- BEGIN
- IF fSelections <> NIL THEN
- DisposeRgn(fSelections); { Dispose regions }
- fSelections := NIL;
-
- IF fHLRegion <> NIL THEN
- DisposeRgn(fHLRegion);
- fHLRegion := NIL;
-
- IF fTempSelections <> NIL THEN
- DisposeRgn(fTempSelections);
- fTempSelections := NIL;
-
- FreeIfObject(fColWidths);
- fColWidths := NIL;
-
- FreeIfObject(fRowHeights);
- fRowHeights := NIL;
-
- INHERITED Free;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.AllCellsDo(PROCEDURE DoToCell(aCell: GridCell));
-
- VAR
- bounds: Rect;
-
- BEGIN
- SetRect(bounds, 1, 1, fNumOfCols, fNumOfRows);
- EachCellDo(bounds.topLeft, bounds.botRight, DoToCell);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.AdornCol(aCol: INTEGER;
- area: Rect);
-
- BEGIN
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.AdornRow(aRow: INTEGER;
- area: Rect);
-
- BEGIN
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.CalcMinSize(VAR minSize: VPoint); OVERRIDE;
-
- BEGIN
- INHERITED CalcMinSize(minSize);
-
- { Set the amount of room needed for that many items }
- minSize.v := fRowHeights.fTotal;
- minSize.h := fColWidths.fTotal;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TGridView.CanSelectCell(aCell: GridCell): BOOLEAN;
-
- BEGIN
- WITH aCell DO
- CanSelectCell := (h >= 1) & (v >= 1) & (h <= fNumOfCols) & (v <= fNumOfRows);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.CellToVRect(aCell: GridCell;
- VAR aRect: VRect);
-
- VAR
- width, height: INTEGER;
-
- BEGIN
- IF (aCell.h < 1) | (aCell.v < 1) | (aCell.h > fNumOfCols) | (aCell.v > fNumOfRows) THEN
- BEGIN
- {$IFC qRangeCheck AND qDebug}
- Writeln('aCell.h = ', aCell.h: 6, ' fNumOfCols = ', fNumOfCols: 6);
- Writeln('aCell.v = ', aCell.v: 6, ' fNumOfRows = ', fNumOfRows: 6);
- ProgramBreak('Range Check in CellToVRect');
- {$ENDC}
- aRect := gZeroVRect;
- END
- ELSE { all the params look OK }
- BEGIN
- width := fColWidths.GetValue(aCell.h);
- IF fColWidths.fNoOfChunks = 1 THEN
- aRect.left := IntMultiply(width, aCell.h - 1)
- ELSE
- aRect.left := fColWidths.SumValues(1, aCell.h - 1);
- aRect.right := aRect.left + width;
-
- height := fRowHeights.GetValue(aCell.v);
- IF fRowHeights.fNoOfChunks = 1 THEN
- aRect.top := IntMultiply(height, aCell.v - 1)
- ELSE
- aRect.top := fRowHeights.SumValues(1, aCell.v - 1);
- aRect.bottom := aRect.top + height;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.ColToVRect(aCol: INTEGER;
- numOfCols: INTEGER;
- VAR aRect: VRect);
-
- VAR
- width: LONGINT;
- leftEdge: LONGINT;
-
- BEGIN
- IF (aCol < 1) | (numOfCols < 1) | (aCol + numOfCols - 1 > fNumOfCols) THEN
- BEGIN
- {$IFC qDebug AND qRangeCheck}
- Writeln('fNumOfCols = ', fNumOfCols: 1, ' aCol = ', aCol: 1);
- ProgramBreak('Range Check in ColToVRect');
- {$ENDC}
- SetVRect(aRect, 0, 0, 0, 0);
- END
- ELSE { all the params look OK }
- BEGIN
- IF (fColWidths.fNoOfChunks = 1) THEN { only one column height }
- BEGIN
- width := GetColWidth(1);
- leftEdge := IntMultiply(width, aCol - 1);
- width := IntMultiply(width, numOfCols);
- END
- ELSE
- BEGIN
- leftEdge := fColWidths.SumValues(1, aCol - 1);
- width := fColWidths.SumValues(aCol, numOfCols);
- END;
-
- SetVRect(aRect, leftEdge, 0, leftEdge + width, fRowHeights.fTotal);
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.CellsToPixels(theCells, thePixels: RgnHandle);
-
- VAR
- cellBounds: Rect;
- visibleRect: Rect;
- visibleVRect: VRect;
- visibleCells: Rect;
- stripRect: Rect;
- aCell: GridCell;
- row, col: INTEGER;
- pixels: VRect;
- prevPixels: VRect;
- prevstripRect: Rect;
- direction: VHSelect;
- startOfStrip: INTEGER;
-
- PROCEDURE AddStrip(endOfStrip: INTEGER);
-
- BEGIN
- IF direction = v THEN
- SetRect(stripRect, col, startOfStrip, col, endOfStrip)
- ELSE
- SetRect(stripRect, startOfStrip, row, endOfStrip, row);
-
- {$IFC qDebug}
- IF gIntenseDebugging THEN
- BEGIN
- WrLblRect('Adding cells', stripRect);
- Writeln;
- END;
- {$ENDC}
-
- IF stripRect.top = prevstripRect.top THEN
- pixels.top := prevPixels.top
- ELSE
- BEGIN
- pixels.top := fRowHeights.SumValues(1, stripRect.top - 1);
- prevPixels.top := pixels.top;
- END;
- IF stripRect.bottom = prevstripRect.bottom THEN
- pixels.bottom := prevPixels.bottom
- ELSE
- BEGIN
- IF stripRect.bottom = stripRect.top THEN
- pixels.bottom := pixels.top + fRowHeights.GetValue(stripRect.bottom)
- ELSE
- pixels.bottom := fRowHeights.SumValues(1, stripRect.bottom);
- prevPixels.bottom := pixels.bottom;
- END;
- IF stripRect.left = prevstripRect.left THEN
- pixels.left := prevPixels.left
- ELSE
- BEGIN
- pixels.left := fColWidths.SumValues(1, stripRect.left - 1);
- prevPixels.left := pixels.left;
- END;
- IF stripRect.right = prevstripRect.right THEN
- pixels.right := prevPixels.right
- ELSE
- BEGIN
- IF stripRect.right = stripRect.left THEN
- pixels.right := pixels.left + fColWidths.GetValue(stripRect.right)
- ELSE
- pixels.right := fColWidths.SumValues(1, stripRect.right);
- prevPixels.right := pixels.right;
- END;
-
- ViewToQDRect(pixels, gTempRgn^^.rgnBBox); { Sneaky, but we know gTempRgn is
- rectangular }
- UnionRgn(gTempRgn, thePixels, thePixels);
-
- prevstripRect := stripRect;
- startOfStrip := 0;
- END;
-
- BEGIN
- SetEmptyRgn(thePixels);
-
- IF NOT EmptyRgn(theCells) & Focus THEN
- IF theCells^^.rgnSize = 10 THEN { the region is a rectangle }
- BEGIN
- cellBounds := theCells^^.rgnBBox;
- SetVRect(pixels, fColWidths.SumValues(1, cellBounds.left - 1), fRowHeights.SumValues(1,
- cellBounds.top - 1), fColWidths.SumValues(1, cellBounds.right - 1),
- fRowHeights.SumValues(1, cellBounds.bottom - 1));
- ViewToQDRect(pixels, thePixels^^.rgnBBox);
- END
- ELSE
- BEGIN
- { Reduce the cells to only those that are visible }
- GetVisibleRect(visibleRect);
- QDToViewRect(visibleRect, visibleVRect);
- visibleCells.topLeft := VPointToLastCell(visibleVRect.topLeft);
- visibleCells.botRight := VPointToLastCell(visibleVRect.botRight);
- WITH visibleCells DO
- SetRectRgn(pVisibleCells, left, top, right + 1, bottom + 1);
- SectRgn(theCells, pVisibleCells, pVisibleCells);
- cellBounds := pVisibleCells^^.rgnBBox;
-
- {$IFC qDebug}
- UseTempRgn('TGridView.CellsToPixels');
- {$ENDC}
- SetEmptyRgn(gTempRgn);
- prevstripRect := gZeroRect;
- direction := LongerSide(cellBounds);
- IF direction = v THEN
- FOR col := cellBounds.left TO cellBounds.right - 1 DO
- BEGIN
- aCell.h := col;
- startOfStrip := 0;
- FOR row := cellBounds.top TO cellBounds.bottom - 1 DO
- BEGIN
- aCell.v := row;
- IF PtInRgn(aCell, pVisibleCells) THEN
- BEGIN
- IF startOfStrip = 0 THEN
- startOfStrip := row
- END
- ELSE IF startOfStrip > 0 THEN
- AddStrip(row - 1);
- END;
- IF startOfStrip > 0 THEN
- AddStrip(cellBounds.bottom - 1);
- END
- ELSE
- FOR row := cellBounds.top TO cellBounds.bottom - 1 DO
- BEGIN
- aCell.v := row;
- startOfStrip := 0;
- FOR col := cellBounds.left TO cellBounds.right - 1 DO
- BEGIN
- aCell.h := col;
- IF PtInRgn(aCell, pVisibleCells) THEN
- BEGIN
- IF startOfStrip = 0 THEN
- startOfStrip := col
- END
- ELSE IF startOfStrip > 0 THEN
- AddStrip(col - 1);
- END;
- IF startOfStrip > 0 THEN
- AddStrip(cellBounds.right - 1);
- END;
- {$IFC qDebug}
- DoneWithTempRgn;
- {$ENDC}
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.DoHighlightSelection(fromHL, toHL: HLState); OVERRIDE;
-
- BEGIN
- IF NOT EmptyRgn(fHLRegion) THEN
- HighlightCells(fHLRegion, fromHL, toHL)
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.HighlightCells(theCells: RgnHandle;
- fromHL, toHL: HLState);
-
- BEGIN
- IF fromHL = hlDim THEN { GridViews don't support dim highlighting }
- fromHL := hlOFF;
- IF toHL = hlDim THEN
- toHL := hlOFF;
-
- IF (fromHL <> toHL) & Focus THEN
- BEGIN
- CellsToPixels(theCells, pPixelsToHighlight);
-
- PenNormal;
- UseSelectionColor;
- InvertRgn(pPixelsToHighlight); { highlight the cells }
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TGridView.DoMouseCommand(VAR theMouse: Point;
- VAR info: EventInfo;
- VAR hysteresis: Point): TCommand; OVERRIDE;
-
- VAR
- aRow, aCol: INTEGER;
- aCellSelectCommand: TCellSelectCommand;
-
- BEGIN
- DoMouseCommand := NIL;
-
- IF IdentifyPoint(theMouse, aRow, aCol) <> badChoice THEN
- BEGIN
- New(aCellSelectCommand);
- FailNIL(aCellSelectCommand);
- aCellSelectCommand.ICellSelectCommand(SELF, info.theShiftKey, info.theCmdKey);
- DoMouseCommand := aCellSelectCommand;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.Draw(area: Rect); OVERRIDE;
-
- VAR
- aRect: VRect;
- bRect: VRect;
- aQDRect: Rect;
- i: INTEGER;
- startCell: GridCell;
- stopCell: GridCell;
- viewArea: VRect;
- colWidth: INTEGER;
- rowHeight: INTEGER;
- constantWidth, constantHeight: BOOLEAN;
- startCellToDraw: GridCell;
- cellsArea: Rect;
-
- BEGIN
- IF (fNumOfRows > 0) & (fNumOfCols > 0) THEN
- BEGIN { make sure we have something to draw }
- QDToViewRect(area, viewArea);
-
- WITH viewArea DO
- BEGIN
- startCell := VPointToLastCell(topLeft);
- stopCell := VPointToLastCell(botRight);
- END;
-
- CellToVRect(startCell, aRect);
- CellToVRect(stopCell, bRect);
- bRect.topLeft := aRect.topLeft;
- ViewToQDRect(bRect, area);
-
- startCellToDraw := startCell;
- cellsArea := area;
- IF viewArea.top >= aRect.bottom - BSR(fRowInset, 1) THEN
- BEGIN
- startCellToDraw.v := startCellToDraw.v + 1;
- cellsArea.top := cellsArea.top - aRect.top + aRect.bottom;
- END;
-
- DrawRangeOfCells(startCellToDraw, stopCell, cellsArea);
-
- IF fAdornCols THEN
- BEGIN
- aQDRect := area;
-
- constantWidth := fColWidths.fNoOfChunks = 1;
- IF constantWidth THEN { only one width }
- colWidth := GetColWidth(1);
-
- FOR i := startCell.h TO stopCell.h DO
- BEGIN
- IF constantWidth THEN
- aQDRect.right := aQDRect.left + colWidth
- ELSE
- aQDRect.right := aQDRect.left + GetColWidth(i);
-
- AdornCol(i, aQDRect);
- aQDRect.left := aQDRect.right;
- END;
- END;
-
- IF fAdornRows THEN
- BEGIN
- aQDRect := area;
-
- constantHeight := fRowHeights.fNoOfChunks = 1;
- IF constantHeight THEN { only one height }
- rowHeight := GetRowHeight(1);
-
- FOR i := startCell.v TO stopCell.v DO
- BEGIN
- IF constantHeight THEN
- aQDRect.bottom := aQDRect.top + rowHeight
- ELSE
- aQDRect.bottom := aQDRect.top + GetRowHeight(i);
-
- AdornRow(i, aQDRect);
- aQDRect.top := aQDRect.bottom;
- END;
- END;
- END;
-
- INHERITED Draw(area);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.DrawRangeOfCells(startCell, stopCell: GridCell;
- aQDRect: Rect);
-
- VAR
- colWidth: INTEGER;
- rowHeight: INTEGER;
- i, j: INTEGER;
- aCell: GridCell;
- left: INTEGER;
-
- BEGIN
-
- aQDRect.left := aQDRect.left + BSR(fColInset, 1); { fColInset DIV 2 }
- aQDRect.top := aQDRect.top + BSR(fRowInset, 1); { fRowInset DIV 2 }
- left := aQDRect.left;
-
- IF fColWidths.fNoOfChunks = 1 THEN { only one width }
- colWidth := GetColWidth(1);
- IF fRowHeights.fNoOfChunks = 1 THEN { only one height }
- rowHeight := GetRowHeight(1);
-
- FOR j := startCell.v TO stopCell.v DO
- BEGIN
- IF fRowHeights.fNoOfChunks = 1 THEN { only one height }
- aQDRect.bottom := aQDRect.top + rowHeight - fRowInset
- ELSE
- aQDRect.bottom := aQDRect.top + GetRowHeight(j) - fRowInset;
-
- aQDRect.left := left; { start back at the left for the next row }
-
- FOR i := startCell.h TO stopCell.h DO
- BEGIN
- IF fColWidths.fNoOfChunks = 1 THEN { only one height }
- aQDRect.right := aQDRect.left + colWidth - fColInset
- ELSE
- aQDRect.right := aQDRect.left + GetColWidth(i) - fColInset;
-
- aCell.h := i;
- aCell.v := j;
- DrawCell(aCell, aQDRect);
-
- aQDRect.left := aQDRect.right + fColInset;
- END;
- aQDRect.top := aQDRect.bottom + fRowInset;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.DrawCell(aCell: GridCell;
- aQDRect: Rect);
-
- BEGIN
- { Should always be overridden.}
-
- {$IFC qDebug}
- Writeln('TGridView: DrawCell MUST be overridden!');
- {$ENDC qDebug}
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TGridView.DelColAt(aCol: INTEGER;
- numOfCols: INTEGER);
-
- VAR
- aRect: VRect;
-
- BEGIN
- IF (aCol < 1) | (numOfCols < 1) | (aCol + numOfCols - 1 > fNumOfCols) THEN
- BEGIN
- IF numOfCols <> 0 THEN
- BEGIN
- {$IFC qDebug AND qRangeCheck}
- Writeln('fNumOfCols = ', fNumOfCols: 1, ' aCol = ', aCol: 1);
- ProgramBreak('Range Check in DelColAt');
- EXIT(DelColAt);
- {$ENDC}
- END;
- END
- ELSE
- BEGIN
- ColToVRect(Max(1, aCol), Max(1, fNumOfCols - aCol + 1), aRect);
- fColWidths.DeleteItems(aCol, numOfCols);
- fNumOfCols := fNumOfCols - numOfCols;
- AdjustSize;
- InvalidVRect(aRect);
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TGridView.DelRowAt(aRow: INTEGER;
- numOfRows: INTEGER);
-
- VAR
- aRect: VRect;
-
- BEGIN
- IF (aRow < 1) | (numOfRows < 1) | (aRow + numOfRows - 1 > fNumOfRows) THEN
- BEGIN
- IF numOfRows <> 0 THEN
- BEGIN
- {$IFC qDebug AND qRangeCheck}
- Writeln('fNumOfRows = ', fNumOfRows: 1, ' aRow = ', aRow: 1);
- ProgramBreak('Range Check in DelRowAt');
- EXIT(DelRowAt);
- {$ENDC}
- END;
- END
- ELSE
- BEGIN
- RowToVRect(Max(1, aRow), Max(1, fNumOfRows - aRow + 1), aRect);
- fRowHeights.DeleteItems(aRow, numOfRows);
- fNumOfRows := fNumOfRows - numOfRows;
- AdjustSize;
- InvalidVRect(aRect);
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TGridView.DelColFirst(numOfCols: INTEGER);
-
- BEGIN
- DelColAt(1, numOfCols);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TGridView.DelRowFirst(numOfRows: INTEGER);
-
- BEGIN
- DelRowAt(1, numOfRows);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TGridView.DelColLast(numOfCols: INTEGER);
-
- BEGIN
- DelColAt(fNumOfCols - numOfCols + 1, numOfCols);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TGridView.DelRowLast(numOfRows: INTEGER);
-
- BEGIN
- DelRowAt(fNumOfRows - numOfRows + 1, numOfRows);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.EachCellDo(startCell, stopCell: GridCell;
- PROCEDURE DoToCell(aCell: GridCell));
-
- VAR
- i, j: INTEGER;
- firstRow: INTEGER;
- lastRow: INTEGER;
- firstCol: INTEGER;
- lastCol: INTEGER;
- aCell: GridCell;
-
- BEGIN
- firstRow := Max(1, startCell.v);
- firstCol := Max(1, startCell.h);
- lastRow := Min(fNumOfRows, stopCell.v);
- lastCol := Min(fNumOfCols, stopCell.h);
-
- FOR j := firstRow TO lastRow DO
- BEGIN
- aCell.v := j;
- FOR i := firstCol TO lastCol DO
- BEGIN
- aCell.h := i;
- DoToCell(aCell);
- END;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.EachSelectedCellDo(PROCEDURE DoToCell(aCell: GridCell));
-
- BEGIN
- EachInRgn(fSelections, DoToCell);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.EachInRgn(aRgn: RgnHandle;
- PROCEDURE DoToCell(aCell: GridCell));
-
- VAR
- row, col: INTEGER;
- aCell: GridCell;
- boundRect: Rect;
-
- BEGIN
- boundRect := aRgn^^.rgnBBox;
- boundRect.right := boundRect.right - 1;
- boundRect.bottom := boundRect.bottom - 1;
- IF aRgn^^.rgnSize = 10 THEN { its a rectangle}
- EachCellDo(boundRect.topLeft, boundRect.botRight, DoToCell)
- ELSE
- FOR row := boundRect.top TO boundRect.bottom DO
- BEGIN
- aCell.v := row;
- FOR col := boundRect.left TO boundRect.right DO
- BEGIN
- aCell.h := col;
- IF PtInRgn(aCell, aRgn) THEN
- DoToCell(aCell);
- END;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TGridView.FirstSelectedCell: GridCell;
-
- VAR
- i, j: INTEGER;
- bounds: Rect;
- aCell: GridCell;
-
- BEGIN
- IF EmptyRgn(fSelections) THEN
- FirstSelectedCell := gZeroPt
- ELSE
- BEGIN
- bounds := fSelections^^.rgnBBox;
- IF fSelections^^.rgnSize = 10 THEN { whole rectangle }
- FirstSelectedCell := bounds.topLeft
- ELSE
- FOR i := bounds.top TO bounds.bottom - 1 DO
- BEGIN
- aCell.v := i;
- FOR j := bounds.left TO bounds.right - 1 DO
- BEGIN
- aCell.h := j;
- IF PtInRgn(aCell, fSelections) THEN
- BEGIN
- FirstSelectedCell := aCell;
- EXIT(FirstSelectedCell);
- END;
- END;
- END
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TGridView.GetColWidth(aCol: INTEGER): INTEGER;
-
- BEGIN
- IF (aCol < 1) | (aCol > fNumOfCols) THEN
- BEGIN
- {$IFC qRangeCheck AND qDebug}
- Writeln('fNumOfCols = ', fNumOfCols: 1, ' aCol = ', aCol: 1);
- ProgramBreak('Range Check in GetColWidth');
- {$ENDC}
- GetColWidth := 0;
- END
- ELSE
- GetColWidth := fColWidths.GetValue(aCol);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TGridView.GetRowHeight(aRow: INTEGER): INTEGER;
-
- BEGIN
- IF (aRow < 1) | (aRow > fNumOfRows) THEN
- BEGIN
- {$IFC qRangeCheck AND qDebug}
- Writeln('fNumOfRows = ', fNumOfRows: 1, ' aRow = ', aRow: 1);
- ProgramBreak('Range Check in GetRowHeight');
- {$ENDC}
- GetRowHeight := 0;
- END
- ELSE
- GetRowHeight := fRowHeights.GetValue(aRow);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.InvalidateCell(aCell: GridCell);
-
- VAR
- aRect: VRect;
-
- BEGIN
- CellToVRect(aCell, aRect);
- InvalidVRect(aRect);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.InvalidateSelection;
-
- BEGIN
- IF Focus THEN
- BEGIN
- CellsToPixels(fSelections, pInvalidateRgn);
- SectRgn(pInvalidateRgn, thePort^.clipRgn, pInvalidateRgn);
- InvalRgn(pInvalidateRgn);
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TGridView.IdentifyPoint(theQDPoint: Point;
- VAR aRow, aCol: INTEGER): GridViewPart;
-
- VAR
- aRect: VRect;
- aPoint: VPoint;
- aCell: GridCell;
- aGridViewPart: GridViewPart;
-
- BEGIN
- QDToViewPt(theQDPoint, aPoint);
- aCell := VPointToCell(aPoint);
- aRow := aCell.v;
- aCol := aCell.h;
-
- IF LONGINT(aCell) = 0 THEN
- aGridViewPart := badChoice
- ELSE
- BEGIN
- CellToVRect(aCell, aRect);
- InsetVRect(aRect, fColInset DIV 2, fRowInset DIV 2);
- aGridViewPart := inCell;
-
- IF fColInset > 0 THEN
- BEGIN
- IF (aPoint.h < aRect.left) THEN
- BEGIN
- aGridViewPart := inColumn; { To the left of the cell }
- END
-
- ELSE IF (aPoint.h >= aRect.right) THEN { Remember PtInRgn will report a point as in
- a region only if the pixel to the right
- and below the point is contained in the
- region. }
- BEGIN
- aGridViewPart := inColumn; { To the right of the cell }
- aCol := aCol + 1;
- END;
- END;
-
- IF fRowInset > 0 THEN
- BEGIN
- IF (aPoint.v < aRect.top) THEN
- BEGIN
- IF (aGridViewPart = inColumn) THEN
- aGridViewPart := inVertex { Click on both }
- ELSE
- aGridViewPart := inRow; { Above the cell }
- END
-
- ELSE IF (aPoint.v >= aRect.bottom) THEN { Remember PtInRgn will report a point as in
- a region only if the pixel to the right
- and below the point is contained in the
- region. }
- BEGIN
- IF (aGridViewPart = inColumn) THEN
- aGridViewPart := inVertex { Click on both }
- ELSE
- aGridViewPart := inRow; { Above the cell }
- aRow := aRow + 1;
- END;
- END;
- END;
- IdentifyPoint := aGridViewPart;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.InsColBefore(aCol: INTEGER;
- numOfCols: INTEGER;
- aWidth: INTEGER);
-
- VAR
- aRect: VRect;
-
- BEGIN
- IF (aCol < 1) | (numOfCols < 1) THEN
- BEGIN
- IF numOfCols <> 0 THEN
- BEGIN
- {$IFC qDebug AND qRangeCheck}
- Writeln('fNumOfCols = ', fNumOfCols: 1, ' aCol = ', aCol: 1);
- ProgramBreak('Range Check in InsColBefore');
- {$ENDC}
- END;
- END
- ELSE
- BEGIN
- fColWidths.InsertItems(aCol, numOfCols, aWidth);
- fNumOfCols := fNumOfCols + numOfCols;
- AdjustSize;
- ColToVRect(Max(1, aCol), Max(1, fNumOfCols - aCol + 1), aRect);
- InvalidVRect(aRect);
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.InsRowBefore(aRow: INTEGER;
- numOfRows: INTEGER;
- aHeight: INTEGER);
-
- VAR
- aRect: VRect;
-
- BEGIN
- IF (aRow < 1) | (numOfRows < 1) THEN
- BEGIN
- IF numOfRows <> 0 THEN
- BEGIN
- {$IFC qDebug AND qRangeCheck}
- Writeln('fNumOfRows = ', fNumOfRows: 1, ' aRow = ', aRow: 1);
- ProgramBreak('Range Check in InsRowBefore');
- {$ENDC}
- END;
- END
- ELSE
- BEGIN
- fRowHeights.InsertItems(aRow, numOfRows, aHeight);
- fNumOfRows := fNumOfRows + numOfRows;
- AdjustSize;
- RowToVRect(Max(1, aRow), Max(1, fNumOfRows - aRow + 1), aRect);
- InvalidVRect(aRect);
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.InsColLast(numOfCols: INTEGER;
- aWidth: INTEGER);
-
- BEGIN
- InsColBefore(fNumOfCols + 1, numOfCols, aWidth);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.InsRowLast(numOfRows: INTEGER;
- aHeight: INTEGER);
-
- BEGIN
- InsRowBefore(fNumOfRows + 1, numOfRows, aHeight);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.InsColFirst(numOfCols: INTEGER;
- aWidth: INTEGER);
-
- BEGIN
- InsColBefore(1, numOfCols, aWidth);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.InsRowFirst(numOfRows: INTEGER;
- aHeight: INTEGER);
-
- BEGIN
- InsRowBefore(1, numOfRows, aHeight);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TGridView.IsCellSelected(aCell: GridCell): BOOLEAN;
-
- BEGIN
- IsCellSelected := PtInRgn(aCell, fSelections);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TGridView.LastSelectedCell: GridCell;
-
- VAR
- i, j: INTEGER;
- bounds: Rect;
- aCell: GridCell;
-
- BEGIN
- LastSelectedCell := gZeroPt;
- IF NOT EmptyRgn(fSelections) THEN
- BEGIN
- bounds := fSelections^^.rgnBBox;
- IF fSelections^^.rgnSize = 10 THEN { whole rectangle }
- BEGIN
- aCell.h := bounds.right - 1;
- aCell.v := bounds.bottom - 1;
- LastSelectedCell := aCell;
- END
- ELSE
- FOR i := bounds.bottom - 1 DOWNTO bounds.top DO
- BEGIN
- aCell.v := i;
- FOR j := bounds.right - 1 DOWNTO bounds.left DO
- BEGIN
- aCell.h := j;
- IF PtInRgn(aCell, fSelections) THEN
- BEGIN
- LastSelectedCell := aCell;
- EXIT(LastSelectedCell);
- END;
- END;
- END
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.RowToVRect(aRow: INTEGER;
- numOfRows: INTEGER;
- VAR aRect: VRect);
-
- VAR
- height: LONGINT;
- topEdge: LONGINT;
-
- BEGIN
- IF (aRow < 1) | (numOfRows < 1) | (aRow + numOfRows - 1 > fNumOfRows) THEN
- BEGIN
- {$IFC qDebug AND qRangeCheck}
- Writeln('fNumOfRows = ', fNumOfRows: 1, ' aRow = ', aRow: 1);
- ProgramBreak('Range Check in RowToVRect');
- {$ENDC}
- SetVRect(aRect, 0, 0, 0, 0);
- END
- ELSE { all the params look OK }
- BEGIN
- IF fRowHeights.fNoOfChunks = 1 THEN { only one row height }
- BEGIN
- height := fRowHeights.GetValue(1);
- topEdge := IntMultiply(height, aRow - 1);
- height := IntMultiply(height, numOfRows);
- END
- ELSE
- BEGIN
- topEdge := fRowHeights.SumValues(1, aRow - 1);
- height := fRowHeights.SumValues(aRow, numOfRows);
- END;
-
- SetVRect(aRect, 0, topEdge, fColWidths.fTotal, topEdge + height);
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.ScrollSelectionIntoView(redraw: BOOLEAN);
-
- VAR
- botRightCell: GridCell;
- topLeftRect, botRightRect, selectionRect: VRect;
- minToSee: Point;
-
- BEGIN
- IF NOT (EmptyRgn(fSelections)) THEN
- BEGIN
- CellToVRect(fSelections^^.rgnBBox.topLeft, topLeftRect);
- SetPt(botRightCell, fSelections^^.rgnBBox.right - 1, fSelections^^.rgnBBox.bottom - 1);
- CellToVRect(botRightCell, botRightRect);
- UnionVRect(topLeftRect, botRightRect, selectionRect);
- minToSee.v := Max(topLeftRect.bottom - topLeftRect.top, botRightRect.bottom -
- botRightRect.top);
- minToSee.h := Max(topLeftRect.right - topLeftRect.left, botRightRect.right -
- botRightRect.left);
- RevealRect(selectionRect, minToSee, redraw);
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TGridView.SetColWidth(aCol: INTEGER;
- numOfCols: INTEGER;
- aWidth: INTEGER);
-
- VAR
- aRect: VRect;
-
- BEGIN
- {$IFC qRangeCheck AND qDebug}
- IF (aCol < 1) | (numOfCols < 1) | (aCol + numOfCols - 1 > fNumOfCols) THEN
- BEGIN
- Writeln('fNumOfCols = ', fNumOfCols: 1, ' aCol = ', aCol: 1);
- ProgramBreak('Range Check in SetColWidth');
- EXIT(SetColWidth);
- END;
- {$ENDC}
-
- IF (fColWidths.fNoOfChunks > 1) | (GetColWidth(1) <> aWidth) THEN
- BEGIN
- fColWidths.DeleteItems(aCol, numOfCols);
- fColWidths.InsertItems(aCol, numOfCols, aWidth);
- AdjustSize;
- ColToVRect(Max(1, aCol), Max(1, fNumOfCols - aCol + 1), aRect);
- InvalidVRect(aRect);
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TGridView.SetRowHeight(aRow: INTEGER;
- numOfRows: INTEGER;
- aHeight: INTEGER);
-
- VAR
- aRect: VRect;
-
- BEGIN
- {$IFC qRangeCheck AND qDebug}
- IF (aRow < 1) | (numOfRows < 1) | (aRow + numOfRows - 1 > fNumOfRows) THEN
- BEGIN
- Writeln('fNumOfRows = ', fNumOfRows: 1, ' aRow = ', aRow: 1);
- ProgramBreak('Range Check in SetRowHeight');
- EXIT(SetRowHeight);
- END;
- {$ENDC}
-
- IF NOT ((fRowHeights.fNoOfChunks = 1) & (GetRowHeight(1) = aHeight)) THEN
- BEGIN
- fRowHeights.DeleteItems(aRow, numOfRows);
- fRowHeights.InsertItems(aRow, numOfRows, aHeight);
- AdjustSize;
- RowToVRect(Max(1, aRow), Max(1, fNumOfRows - aRow + 1), aRect);
- InvalidVRect(aRect);
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.SelectCell(theCell: GridCell;
- extendSelection, highlight, select: BOOLEAN);
-
- BEGIN
- WITH theCell DO
- SetSelectionRect(h, v, h, v, extendSelection, highlight, select);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.SetEmptySelection(highlight: BOOLEAN);
-
- BEGIN
- SetEmptyRgn(fTempSelections);
- SetSelection(fTempSelections, kDontExtend, highlight, kSelect);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.SetSelection(cellsToSelect: RgnHandle;
- extendSelection, highlight, select: BOOLEAN);
-
- BEGIN
- {$IFC qDebug}
- WITH cellsToSelect^^.rgnBBox DO
- IF fSingleSelection & ((right - left > 1) | (bottom - top > 1)) THEN
- ProgramBreak('Attempt to select multiple cells when fSingleSelection is true');
- IF NOT EmptyRgn(cellsToSelect) THEN
- WITH cellsToSelect^^.rgnBBox DO
- IF (left < 1) | (top < 1) | (right > fNumOfCols + 1) | (bottom > fNumOfRows + 1) THEN
- ProgramBreak('Attempted selection is outside the range of cells');
- {$ENDC}
-
- IF highlight THEN
- CopyRgn(fSelections, pPreviousSelection); { save the old selection }
-
- {$IFC qDebug}
- UseTempRgn('TGridView.SetSelection');
- {$ENDC}
- SetRectRgn(gTempRgn, 1, 1, fNumOfCols + 1, fNumOfRows + 1);
- SectRgn(cellsToSelect, gTempRgn, gTempRgn);
-
- IF extendSelection & select THEN { extend the selection region }
- UnionRgn(gTempRgn, fSelections, fSelections)
- ELSE IF select THEN { reset the selection region }
- CopyRgn(gTempRgn, fSelections)
- ELSE { need to de-select the new region }
- DiffRgn(fSelections, gTempRgn, fSelections);
- {$IFC qDebug}
- DoneWithTempRgn;
- {$ENDC}
-
- CopyRgn(fSelections, fHLRegion);
-
- IF highlight THEN
- BEGIN
- { Turn the deselected cells off }
- DiffRgn(pPreviousSelection, fSelections, pDifference);
- HighlightCells(pDifference, fHLDesired, hlOFF);
-
- { Turn the newly selected cells on }
- DiffRgn(fSelections, pPreviousSelection, pDifference);
- HighlightCells(pDifference, hlOFF, fHLDesired);
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TGridView.SetSelectionRect(left, top, right, bottom: INTEGER;
- extendSelection, highlight, select: BOOLEAN);
-
- BEGIN
- IF (left = 0) & (top = 0) & (right = 0) & (bottom = 0) THEN
- SetEmptyRgn(fTempSelections)
- ELSE
- SetRectRgn(fTempSelections, left, top, right + 1, bottom + 1);
- SetSelection(fTempSelections, extendSelection, highlight, select);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TGridView.SetSingleSelection(theSetting: BOOLEAN);
-
- BEGIN
- fSingleSelection := theSetting;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TGridView.VPointToCell(aPoint: VPoint): GridCell;
-
- VAR
- aCell: GridCell;
-
- BEGIN
- aCell.h := fColWidths.FindItem(aPoint.h);
- aCell.v := fRowHeights.FindItem(aPoint.v);
- IF (aCell.h = 0) | (aCell.v = 0) THEN
- VPointToCell := gZeroPt
- ELSE
- VPointToCell := aCell;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TGridView.VPointToLastCell(aPoint: VPoint): GridCell;
-
- VAR
- aCell: GridCell;
-
- BEGIN
- aCell.h := fColWidths.FindItem(aPoint.h);
- IF aCell.h = 0 THEN { If its invalid, return the last column }
- aCell.h := fNumOfCols;
-
- aCell.v := fRowHeights.FindItem(aPoint.v);
- IF aCell.v = 0 THEN { If its invalid, return the last row }
- aCell.v := fNumOfRows;
-
- VPointToLastCell := aCell;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVFields}
-
- PROCEDURE TGridView.Fields(PROCEDURE DoToField(fieldName: Str255;
- fieldAddr: Ptr;
- fieldType: INTEGER)); OVERRIDE;
-
- BEGIN
- DoToField('TGridView', NIL, bClass);
- DoToField('fSelections', @fSelections, bRgnHandle);
- DoToField('fHLRegion', @fHLRegion, bRgnHandle);
- DoToField('fTempSelections', @fTempSelections, bRgnHandle);
- DoToField('fNumOfRows', @fNumOfRows, bInteger);
- DoToField('fRowHeights', @fRowHeights, bObject);
- DoToField('fNumOfCols', @fNumOfCols, bInteger);
- DoToField('fColWidths', @fColWidths, bObject);
- DoToField('fRowInset', @fRowInset, bInteger);
- DoToField('fColInset', @fColInset, bInteger);
- DoToField('fAdornRows', @fAdornRows, bBoolean);
- DoToField('fAdornCols', @fAdornCols, bBoolean);
- DoToField('fSingleSelection', @fSingleSelection, bBoolean);
-
- INHERITED Fields(DoToField);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVOpen}
-
- PROCEDURE TTextGridView.ITextGridView(itsDocument: TDocument; { Its document }
- itsSuperView: TView; { Its parent view }
- itsLocation: VPoint; { Top, Left in parent's coords }
- itsSize: VPoint;
- itsHSizeDet, itsVSizeDet: SizeDeterminer; { Size determiners }
- numOfRows: INTEGER; { Number of rows initially }
- numOfCols: INTEGER; { Number of columns initially }
- rowHeight: INTEGER; { Row height, or zero for font height }
- colWidth: INTEGER; { Width of items in the columns }
- adornRows: BOOLEAN; { Adornment for Rows? }
- adornCols: BOOLEAN; { Adornment for Columns? }
- rowInset: INTEGER; { horizontal space between cells }
- colInset: INTEGER; { vertical space between cells }
- singleSelection: BOOLEAN; { single cell selection? }
- itsTextStyle: TextStyle); { size, color, etc. font info }
-
- BEGIN
- fTextStyle := itsTextStyle;
-
- SetUpFont;
- IF rowHeight = 0 THEN
- rowHeight := fLineHeight + rowInset;
-
- IGridView(itsDocument, itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet, numOfRows,
- numOfCols, rowHeight, colWidth, adornRows, adornCols, rowInset, colInset,
- singleSelection);
-
- IF (fNumOfCols = 1) & (fSizeDeterminer[h] <> sizeFixed) & (GetColWidth(1) = 0) & (fSuperView <>
- NIL) THEN
- SetColWidth(1, fNumOfCols, fSuperView.fSize.h);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVOpen}
-
- PROCEDURE TTextGridView.IRes(itsDocument: TDocument;
- itsSuperView: TView;
- VAR itsParams: Ptr); OVERRIDE;
-
- VAR
- itsTextStyle: TextStyle;
-
- BEGIN
- { The ancestor will need to focus when adding rows or columns.
- Get the information necessary to focus since this class sets textStyle when focusing }
- fTextStyle := gSystemStyle; { Put in safe state }
-
- INHERITED IRes(itsDocument, itsSuperView, itsParams);
-
- WITH TextGridViewTemplatePtr(itsParams)^ DO
- BEGIN
- SetTextStyle(itsTextStyle, GetFontNum(itsFontName), itsFontFace, itsFontSize, itsFontColor);
- fTextStyle := itsTextStyle;
- END;
-
- SetUpFont;
-
- IF fNumOfRows > 0 THEN
- IF GetRowHeight(1) = 0 THEN { set row height from font }
- SetRowHeight(1, fNumOfRows, fLineHeight + fRowInset);
-
- IF (fNumOfCols = 1) & (fSizeDeterminer[h] <> sizeFixed) & (GetColWidth(1) = 0) THEN
- SetColWidth(1, fNumOfCols, fSize.h);
-
- OffsetPtrWStr(itsParams, SIZEOF(TextGridViewTemplate));
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TTextGridView.WRes(theResource: ViewRsrcHndl;
- VAR itsParams: Ptr); OVERRIDE;
-
- VAR
- theSize: INTEGER;
- theFont: Str255;
- tgPtr: TextGridViewTemplatePtr;
-
- BEGIN
- INHERITED WRes(theResource, itsParams);
-
- theSize := fTextStyle.tsSize;
- GetPortFontInfo(fTextStyle.tsFont, theFont, theSize);
-
- tgPtr := TextGridViewTemplatePtr(ExpandPtrWStr(theResource, itsParams,
- SIZEOF(TextGridViewTemplate), LENGTH(theFont)));
-
- WITH tgPtr^, fTextStyle DO
- BEGIN
- itsFontFace := tsFace;
- itsFontSize := theSize;
- itsFontColor := tsColor;
- { itsFontName := theFont; }
- END;
- CopyStr255(theFont, PRStr(tgPtr^.itsFontName));
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TTextGridView.WriteRes(theResource: ViewRsrcHndl;
- VAR itsParams: Ptr); OVERRIDE;
-
- BEGIN
- gWResSignature := 'txtg'; gWResType := 'TTextGridView';
- WRes(theResource, itsParams);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TTextGridView.DrawCell(aCell: GridCell;
- aQDRect: Rect); OVERRIDE;
-
- VAR
- theText: Str255;
-
- BEGIN
- GetText(aCell, theText);
-
- IF (GetColWidth(aCell.h) > 0) THEN
- MADrawString(@theText, aQDRect, teJustSystem);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TTextGridView.Focus: BOOLEAN; OVERRIDE;
-
- BEGIN
- IF INHERITED Focus THEN
- BEGIN
- SetPen;
- Focus := TRUE;
- END
- ELSE
- Focus := FALSE;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVOpen}
-
- PROCEDURE TTextGridView.SetUpFont;
-
- VAR
- savedPort: GrafPtr;
- theFontInfo: FontInfo;
-
- BEGIN
- GetPort(savedPort);
- SetPort(gWorkPort);
-
- SetPen;
- GetFontInfo(theFontInfo);
-
- SetPort(savedPort);
-
- WITH theFontInfo DO
- BEGIN
- fLineHeight := ascent + descent + leading;
- fLineAscent := ascent + (leading DIV 2);
- END;
-
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TTextGridView.SetPen;
-
- VAR
- itsTextStyle: TextStyle;
-
- BEGIN
- itsTextStyle := fTextStyle;
- SetPortTextStyle(itsTextStyle);
- PenNormal;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TTextGridView.GetText(aCell: GridCell;
- VAR aString: Str255);
-
- BEGIN
- { MUST be overridden! }
-
- {$IFC qDebug}
- Writeln('TTextGridView: GetText MUST be OVERRIDDEN!');
- {$ENDC qDebug}
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVFields}
-
- PROCEDURE TTextGridView.Fields(PROCEDURE DoToField(fieldName: Str255;
- fieldAddr: Ptr;
- fieldType: INTEGER)); OVERRIDE;
-
- BEGIN
- DoToField('TTextGridView', NIL, bClass);
- DoToField('fLineHeight', @fLineHeight, bInteger);
- DoToField('fLineAscent', @fLineAscent, bInteger);
- {$Push} {$H-}
- TextStyleFields('fTextStyle', fTextStyle, DoToField);
- {$Pop}
-
- INHERITED Fields(DoToField);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVOpen}
-
- PROCEDURE TTextListView.ITextListView(itsDocument: TDocument; { Its document }
- itsSuperView: TView; { Its parent view }
- itsLocation: VPoint; { Top, Left in parent's coords }
- itsSize: VPoint;
- itsHSizeDet, itsVSizeDet: SizeDeterminer; { Size determiners }
- numOfItems: INTEGER; { Number of items initially }
- rowHeight: INTEGER; { Row height, or zero for font height }
- colWidth: INTEGER; { Width of items in the columns }
- adornRows: BOOLEAN; { Draw the row adornments? }
- adornCols: BOOLEAN; { Draw the col adornment? }
- rowInset: INTEGER; { Amount to inset the rows }
- colInset: INTEGER; { Amount to inset the column }
- singleSelection: BOOLEAN; { single cell selection? }
- itsTextStyle: TextStyle); { size, color, etc. font info }
-
- BEGIN
- ITextGridView(itsDocument, itsSuperView, itsLocation, itsSize, itsHSizeDet, itsVSizeDet,
- numOfItems, 1, rowHeight, colWidth, adornRows, adornCols, rowInset, colInset,
- singleSelection, itsTextStyle);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TTextListView.WriteRes(theResource: ViewRsrcHndl;
- VAR itsParams: Ptr); OVERRIDE;
-
- BEGIN
- gWResSignature := 'lstg'; gWResType := 'TTextListView';
- WRes(theResource, itsParams);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TTextListView.AllItemsDo(PROCEDURE DoToItem(anItem: INTEGER));
-
- BEGIN
- EachItemDo(1, fNumOfRows, DoToItem);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TTextListView.CanSelectCell(aCell: GridCell): BOOLEAN; OVERRIDE;
-
- BEGIN
- CanSelectCell := INHERITED CanSelectCell(aCell) & CanSelectItem(aCell.v);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TTextListView.CanSelectItem(anItem: INTEGER): BOOLEAN;
-
- BEGIN
- CanSelectItem := (anItem >= 1) & (anItem <= fNumOfRows);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TTextListView.DelItemAt(anItem: INTEGER;
- numOfItems: INTEGER);
-
- BEGIN
- DelRowAt(anItem, numOfItems);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TTextListView.DelItemFirst(numOfItems: INTEGER);
-
- BEGIN
- DelItemAt(1, numOfItems);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TTextListView.DelItemLast(numOfItems: INTEGER);
-
- BEGIN
- DelItemAt(fNumOfRows - numOfItems + 1, numOfItems);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TTextListView.EachItemDo(start, stop: INTEGER;
- PROCEDURE DoToItem(anItem: INTEGER));
-
- VAR
- i: INTEGER;
-
- BEGIN
- FOR i := start TO stop DO
- DoToItem(i);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TTextListView.EachSelectedItemDo(PROCEDURE
- DoToItem(anItem: INTEGER));
-
- PROCEDURE DoToCell(aCell: GridCell);
-
- BEGIN
- DoToItem(aCell.v);
- END;
-
- BEGIN
- EachInRgn(fSelections, DoToCell);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TTextListView.FirstSelectedItem: INTEGER;
-
- VAR
- aGridCell: GridCell;
-
- BEGIN
- aGridCell := FirstSelectedCell;
- FirstSelectedItem := aGridCell.v;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TTextListView.GetItemHeight(anItem: INTEGER): INTEGER;
-
- BEGIN
- GetItemHeight := GetRowHeight(anItem);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TTextListView.GetItemWidth: INTEGER;
-
- BEGIN
- GetItemWidth := GetColWidth(1);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TTextListView.GetItemText(anItem: INTEGER;
- VAR aString: Str255);
-
- BEGIN
- { MUST be overridden !!! }
-
- {$IFC qDebug}
- Writeln('TTextListView: GetItemText MUST be OVERRIDDEN!');
- {$ENDC qDebug}
-
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TTextListView.GetText(aCell: GridCell;
- VAR aString: Str255); OVERRIDE;
-
- BEGIN
- GetItemText(aCell.v, aString);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TTextListView.InsItemBefore(anItem: INTEGER;
- numOfItems: INTEGER);
-
- BEGIN
- InsRowBefore(anItem, numOfItems, fLineHeight + fRowInset);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TTextListView.InsItemFirst(numOfItems: INTEGER);
-
- BEGIN
- InsItemBefore(1, numOfItems);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TTextListView.InsItemLast(numOfItems: INTEGER);
-
- BEGIN
- InsItemBefore(fNumOfRows + 1, numOfItems);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TTextListView.InvalidateItem(anItem: INTEGER);
-
- VAR
- aCell: GridCell;
-
- BEGIN
- aCell.h := 1;
- aCell.v := anItem;
- InvalidateCell(aCell);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TTextListView.IsItemSelected(anItem: INTEGER): BOOLEAN;
-
- VAR
- aCell: GridCell;
-
- BEGIN
- aCell.h := 1;
- aCell.v := anItem;
- IsItemSelected := IsCellSelected(aCell);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- FUNCTION TTextListView.LastSelectedItem: INTEGER;
-
- VAR
- aGridCell: GridCell;
-
- BEGIN
- aGridCell := LastSelectedCell;
- LastSelectedItem := aGridCell.v;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TTextListView.Resize(width, height: VCoordinate;
- invalidate: BOOLEAN); OVERRIDE;
-
- BEGIN
- INHERITED Resize(width, height, invalidate);
- IF fNumOfCols = 1 THEN
- BEGIN
- fColWidths.fTotal := fColWidths.fTotal - fColWidths.fChunks^^[0].value + width;
- fColWidths.fChunks^^[0].value := width;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TTextListView.SelectCell(theCell: GridCell;
- extendSelection, highlight, select: BOOLEAN); OVERRIDE;
-
- BEGIN
- SelectItem(theCell.v, extendSelection, highlight, select);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVRes}
-
- PROCEDURE TTextListView.SelectItem(anItem: INTEGER;
- extendSelection, highlight, select: BOOLEAN);
-
- VAR
- aCell: GridCell;
-
- BEGIN
- aCell.v := anItem;
- aCell.h := Min(1, anItem);
-
- INHERITED SelectCell(aCell, extendSelection, highlight, select);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TTextListView.SetItemHeight(anItem: INTEGER;
- numOfItems: INTEGER;
- aHeight: INTEGER);
-
- BEGIN
- SetRowHeight(anItem, numOfItems, aHeight);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVNonRes}
-
- PROCEDURE TTextListView.SetItemWidth(aWidth: INTEGER);
-
- BEGIN
- SetColWidth(1, 1, aWidth);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVFields}
-
- PROCEDURE TTextListView.Fields(PROCEDURE DoToField(fieldName: Str255;
- fieldAddr: Ptr;
- fieldType: INTEGER)); OVERRIDE;
-
- BEGIN
- DoToField('TTextListView', NIL, bClass);
- INHERITED Fields(DoToField);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVSelCommand}
-
- PROCEDURE TCellSelectCommand.ICellSelectCommand(itsView: TGridView;
- theShiftKey, theCmdKey: BOOLEAN);
-
- VAR
- fi: FailInfo;
-
- PROCEDURE HandleFailure(error: OSErr;
- message: LONGINT);
-
- BEGIN
- Free;
- END;
-
- BEGIN
- fThisSelection := NIL;
- fPrevSelection := NIL;
- fDifference := NIL;
- fGridView := NIL;
-
- fShiftKey := theShiftKey;
- fCmdKey := theCmdKey;
-
- ICommand(cNoCommand, NIL, itsView, itsView.GetScroller(FALSE));
- fCanUndo := FALSE;
- fCausesChange := FALSE;
- fViewConstrain := FALSE;
-
- fGridView := itsView;
-
- fAnchorCell := gZeroPt; { At least set it to something }
- fPrevCell.h := - 1; { ??? Blech! there must be a better way }
- fPrevCell.v := - 1; { ??? Blech! there must be a better way }
-
- CatchFailures(fi, HandleFailure);
- fPrevSelection := MakeNewRgn;
- CopyRgn(fGridView.fSelections, fPrevSelection);
- fThisSelection := fGridView.fHLRegion;
- SetEmptyRgn(fThisSelection);
- fDifference := MakeNewRgn;
- Success(fi);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVDoCommand}
-
- PROCEDURE TCellSelectCommand.Free; OVERRIDE;
-
- BEGIN
- IF fPrevSelection <> NIL THEN
- DisposeRgn(fPrevSelection);
- fPrevSelection := NIL;
-
- IF fDifference <> NIL THEN
- DisposeRgn(fDifference);
- fDifference := NIL;
-
- fThisSelection := NIL; { I don't own it so I don't dispose it. But,
- I sure don't need a reference to it any
- more. }
-
- INHERITED Free;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVDoCommand}
-
- PROCEDURE TCellSelectCommand.ComputeAnchorCell(VAR clickedCell: GridCell);
-
- BEGIN
- fAnchorCell := clickedCell;
-
- IF fShiftKey & (NOT EmptyRgn(fPrevSelection)) THEN
- WITH fPrevSelection^^.rgnBBox DO
- BEGIN
- IF fAnchorCell.h >= left THEN
- fAnchorCell.h := left
- ELSE
- fAnchorCell.h := right - 1;
- IF fAnchorCell.v >= top THEN
- fAnchorCell.v := top
- ELSE
- fAnchorCell.v := bottom - 1;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVDoCommand}
-
- PROCEDURE TCellSelectCommand.ComputeNewSelection(VAR clickedCell: GridCell);
-
- VAR
- r: Rect;
-
- BEGIN
- IF fGridView.CanSelectCell(clickedCell) THEN
- BEGIN
- IF fGridView.fSingleSelection | (NOT fShiftKey) THEN
- SetRect(r, clickedCell.h, clickedCell.v, clickedCell.h + 1, clickedCell.v + 1)
- ELSE
- BEGIN
- Pt2Rect(fAnchorCell, clickedCell, r);
- r.right := r.right + 1;
- r.bottom := r.bottom + 1;
- END;
- RectRgn(fThisSelection, r);
- IF fCmdKey & (NOT fGridView.fSingleSelection) THEN
- IF fDeselecting THEN
- DiffRgn(fPrevSelection, fThisSelection, fThisSelection)
- ELSE
- UnionRgn(fPrevSelection, fThisSelection, fThisSelection);
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVDoCommand}
-
- PROCEDURE TCellSelectCommand.HighlightNewSelection;
-
- BEGIN
- { Turn off previously selected cells }
- DiffRgn(fPrevSelection, fThisSelection, fDifference);
- fGridView.HighlightCells(fDifference, fGridView.fHLDesired, hlOFF);
-
- { Turn on newly selected cells}
- DiffRgn(fThisSelection, fPrevSelection, fDifference);
- fGridView.HighlightCells(fDifference, hlOFF, fGridView.fHLDesired);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVDoCommand}
-
- PROCEDURE TCellSelectCommand.TrackFeedback(anchorPoint, nextPoint: VPoint;
- turnItOn, mouseDidMove: BOOLEAN); OVERRIDE;
-
- BEGIN
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVDoCommand}
-
- FUNCTION TCellSelectCommand.TrackMouse(aTrackPhase: TrackPhase;
- VAR anchorPoint, previousPoint, nextPoint: VPoint;
- mouseDidMove: BOOLEAN): TCommand; OVERRIDE;
-
- VAR
- clickedCell: GridCell;
- viewExtent: VRect;
- clippedPoint: VPoint;
-
- BEGIN
- IF mouseDidMove THEN
- BEGIN
- fGridView.GetExtent(viewExtent);
- clippedPoint := nextPoint;
- PinVRect(viewExtent, clippedPoint);
- clickedCell := fGridView.VPointToCell(clippedPoint);
- IF aTrackPhase = TrackPress THEN
- BEGIN
- ComputeAnchorCell(clickedCell);
- IF fCmdKey THEN
- fDeselecting := PtInRgn(fAnchorCell, fGridView.fSelections);
- END;
-
- IF LONGINT(clickedCell) <> LONGINT(fPrevCell) THEN
- BEGIN
- ComputeNewSelection(clickedCell);
- HighlightNewSelection;
-
- CopyRgn(fThisSelection, fPrevSelection);
- fPrevCell := clickedCell;
- END;
- END;
- TrackMouse := SELF;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVDoCommand}
-
- PROCEDURE TCellSelectCommand.DoIt; OVERRIDE;
-
- BEGIN
- IF fGridView.fSingleSelection THEN
- fGridView.SelectCell(fThisSelection^^.rgnBBox.topLeft, kDontExtend, kDontHighlight, kSelect)
- ELSE
- fGridView.SetSelection(fThisSelection, kDontExtend, kDontHighlight, kSelect);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVFields}
-
- PROCEDURE TCellSelectCommand.Fields(PROCEDURE DoToField(fieldName: Str255;
- fieldAddr: Ptr;
- fieldType: INTEGER)); OVERRIDE;
-
- BEGIN
- DoToField('TCellSelectCommand', NIL, bClass);
- DoToField('fGridView', @fGridView, bObject);
- DoToField('fShiftKey', @fShiftKey, bBoolean);
- DoToField('fCmdKey', @fCmdKey, bBoolean);
- DoToField('fDeselecting', @fDeselecting, bBoolean);
- DoToField('fAnchorCell', @fAnchorCell, bPoint);
- DoToField('fPrevCell', @fPrevCell, bPoint);
- DoToField('fThisSelection', @fThisSelection, bRgnHandle);
- DoToField('fPrevSelection', @fPrevSelection, bRgnHandle);
- DoToField('fDifference', @fDifference, bRgnHandle);
-
- INHERITED Fields(DoToField);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVDoCommand}
-
- PROCEDURE TRCSelectCommand.ComputeNewSelection(VAR clickedCell: GridCell); OVERRIDE;
-
- VAR
- r: Rect;
-
- BEGIN
- IF fGridView.CanSelectCell(clickedCell) THEN
- BEGIN
- IF fGridView.fSingleSelection THEN
- SetRect(r, clickedCell.h, clickedCell.v, clickedCell.h + 1, clickedCell.v + 1)
- ELSE
- BEGIN
- Pt2Rect(fAnchorCell, clickedCell, r);
- r.right := r.right + 1;
- r.bottom := r.bottom + 1;
- END;
- RectRgn(fThisSelection, r);
- IF fCmdKey & (NOT fGridView.fSingleSelection) THEN
- IF fDeselecting THEN
- DiffRgn(fPrevSelection, fThisSelection, fThisSelection)
- ELSE
- UnionRgn(fPrevSelection, fThisSelection, fThisSelection);
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVDoCommand}
-
- FUNCTION TRCSelectCommand.TrackMouse(aTrackPhase: TrackPhase;
- VAR anchorPoint, previousPoint, nextPoint: VPoint;
- mouseDidMove: BOOLEAN): TCommand; OVERRIDE;
-
- VAR
- clickedCell: GridCell;
- viewExtent: VRect;
- clippedPoint: VPoint;
-
- BEGIN
- IF mouseDidMove THEN
- BEGIN
- fGridView.GetExtent(viewExtent);
- clippedPoint := nextPoint;
- PinVRect(viewExtent, clippedPoint);
- clickedCell := fGridView.VPointToCell(clippedPoint);
- IF aTrackPhase = TrackPress THEN
- BEGIN
- ComputeAnchorCell(clickedCell);
- IF fCmdKey THEN
- fDeselecting := PtInRgn(fAnchorCell, fGridView.fSelections);
- END;
-
- IF LONGINT(clickedCell) <> LONGINT(fPrevCell) THEN
- BEGIN
- IF (NOT fShiftKey) & (aTrackPhase <> TrackPress) THEN
- BEGIN
- ComputeAnchorCell(clickedCell);
- IF fCmdKey THEN
- fDeselecting := PtInRgn(fAnchorCell, fGridView.fSelections);
- END;
- ComputeNewSelection(clickedCell);
- HighlightNewSelection;
-
- CopyRgn(fThisSelection, fPrevSelection);
- fPrevCell := clickedCell;
- END;
- END;
- TrackMouse := SELF;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVFields}
-
- PROCEDURE TRCSelectCommand.Fields(PROCEDURE DoToField(fieldName: Str255;
- fieldAddr: Ptr;
- fieldType: INTEGER)); OVERRIDE;
-
- BEGIN
- DoToField('TRCSelectCommand', NIL, bClass);
- INHERITED Fields(DoToField);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVSelCommand}
-
- PROCEDURE TRowSelectCommand.IRowSelectCommand(itsView: TGridView;
- theShiftKey, theCmdKey: BOOLEAN);
-
- BEGIN
- ICellSelectCommand(itsView, theShiftKey, theCmdKey);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVDoCommand}
-
- PROCEDURE TRowSelectCommand.ComputeAnchorCell(VAR clickedCell: GridCell); OVERRIDE;
-
- BEGIN
- INHERITED ComputeAnchorCell(clickedCell);
- fAnchorCell.h := 1;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVDoCommand}
-
- PROCEDURE TRowSelectCommand.ComputeNewSelection(VAR clickedCell: GridCell); OVERRIDE;
-
- BEGIN
- clickedCell.h := fGridView.fNumOfCols;
- INHERITED ComputeNewSelection(clickedCell);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVFields}
-
- PROCEDURE TRowSelectCommand.Fields(PROCEDURE DoToField(fieldName: Str255;
- fieldAddr: Ptr;
- fieldType: INTEGER)); OVERRIDE;
-
- BEGIN
- DoToField('TRowSelectCommand', NIL, bClass);
- INHERITED Fields(DoToField);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVSelCommand}
-
- PROCEDURE TColumnSelectCommand.IColumnSelectCommand(itsView: TGridView;
- theShiftKey, theCmdKey: BOOLEAN);
-
- BEGIN
- ICellSelectCommand(itsView, theShiftKey, theCmdKey);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVDoCommand}
-
- PROCEDURE TColumnSelectCommand.ComputeAnchorCell(VAR clickedCell: GridCell); OVERRIDE;
-
- BEGIN
- INHERITED ComputeAnchorCell(clickedCell);
- fAnchorCell.v := 1;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVDoCommand}
-
- PROCEDURE TColumnSelectCommand.ComputeNewSelection(VAR clickedCell: GridCell); OVERRIDE;
-
- BEGIN
- clickedCell.v := fGridView.fNumOfRows;
- INHERITED ComputeNewSelection(clickedCell);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S GVFields}
-
- PROCEDURE TColumnSelectCommand.Fields(PROCEDURE DoToField(fieldName: Str255;
- fieldAddr: Ptr;
- fieldType: INTEGER)); OVERRIDE;
-
- BEGIN
- DoToField('TColumnSelectCommand', NIL, bClass);
- INHERITED Fields(DoToField);
- END;
-